home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / units / egadraw.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-01  |  23.8 KB  |  866 lines
  1. UNIT EgaDraw;
  2.  
  3. INTERFACE
  4.  
  5. CONST   Ega640x350=000; Black  =0; DarkGray  = 8; Buttons   =004;
  6.         Ega640x200=001; Blue   =1; LightBlue = 9; Horizontal=003;
  7.         Ega320x200=002; Green  =2; LightGreen=10; Vertical  =002;
  8.     Vga640x480=003; Cyan   =3; LightCyan =11; Keyboard  =001;
  9.         Unknown   =255; Red    =4; LightRed  =12; NoEvent   =000;
  10.         CapsLock  =064; Magenta=5; Pink      =13; ON        =TRUE;
  11.         NumLock   =032; Brown  =6; Yellow    =14; OFF       =FALSE;
  12.         ScrollLock=016; Gray   =7; White     =15;
  13.         Toggle    =002; Light  =1; Dark      = 0;
  14.  
  15. TYPE    Button=OBJECT
  16.           Xa,Ya,Xb,Yb:WORD; Fg,Bg,Hl,Sd:BYTE; Title,Oldtt:STRING; Paa:BOOLEAN;
  17.           PROCEDURE Draw;
  18.           PROCEDURE Remove;
  19.           PROCEDURE Init(Ax,Ay,Bx,By:WORD; F,B,H,S:BYTE; T:STRING);
  20.           FUNCTION  Pressed:BOOLEAN;
  21.           FUNCTION  Switched:BOOLEAN;
  22.         END;
  23.  
  24.     Window=OBJECT
  25.       Xa,Ya,Xb,Yb,Xl,Yl:INTEGER; Fg,Bg,Hl,Sd,Sc:BYTE; Title:STRING; Seen:BOOLEAN;
  26.           PROCEDURE Draw;
  27.           PROCEDURE Remove;
  28.           PROCEDURE Init(A,B,C,D:WORD; E,F,G,H:BYTE; I:STRING; J:BYTE);
  29.           PROCEDURE WriteLine(A,B:WORD; C:STRING);
  30.           PROCEDURE Line(A,B,C,D,E:INTEGER);
  31.           PROCEDURE SetPix(X,Y:WORD; C:BYTE);
  32.           FUNCTION  GetPix(X,Y:WORD):BYTE;
  33.       FUNCTION  Test:BOOLEAN;
  34.         END;
  35.  
  36. VAR     Colors,Mode,TheEvent,ScanCode,Fh:BYTE;
  37.         xMax,yMax,Video,Mb,Mx,My    :WORD;
  38.         Sound                           :BOOLEAN;
  39.         MousePtr                        :ARRAY[0..33] OF WORD;
  40.  
  41. {---------------------------------------------------------------------------}
  42. PROCEDURE Klick(F,L:WORD);
  43. PROCEDURE BackToText;
  44. FUNCTION  CurKey:CHAR;
  45. FUNCTION  GetKey:CHAR;
  46. FUNCTION  Event:BOOLEAN;
  47. FUNCTION  KeyPressed:BOOLEAN;
  48. PROCEDURE DefLed(Led,Mtd:BYTE);
  49. {---------------------------------------------------------------------------}
  50. PROCEDURE EgaMode(Md:BYTE);
  51. FUNCTION  GetPix(X,Y:WORD):BYTE;
  52. PROCEDURE SetPix(X,Y:WORD; Color:BYTE);
  53. PROCEDURE Clear(Color:BYTE);
  54. PROCEDURE Line(X1,Y1,X2,Y2:INTEGER; Col:BYTE);
  55. PROCEDURE Hline(Xa,Xb,Y:WORD; Color:BYTE);
  56. PROCEDURE Vline(Ya,Yb,X:WORD; Color:BYTE);
  57. PROCEDURE FBox(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  58. PROCEDURE Box(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  59. {---------------------------------------------------------------------------}
  60. PROCEDURE InitMouseIntr;
  61. PROCEDURE EndMouseIntr;
  62. FUNCTION  MouseReset:BOOLEAN;
  63. PROCEDURE Mouse(Vs:BOOLEAN);
  64. PROCEDURE SaveMouse;
  65. PROCEDURE RestoreMouse;
  66. PROCEDURE SetMousePos(X,Y:WORD);
  67. PROCEDURE SetMousePtr;
  68. PROCEDURE Arrow;
  69. PROCEDURE Waiting;
  70. {---------------------------------------------------------------------------}
  71. PROCEDURE UseFont(Ptr:POINTER);
  72. PROCEDURE PlotChar(X,Y:INTEGER; Ch:BYTE; Color,Bg:BYTE);
  73. PROCEDURE DrawChar(X,Y:INTEGER; Ch:BYTE; Color:BYTE);
  74. PROCEDURE WriteLine(X,Y:INTEGER; S:STRING; C,B:BYTE);
  75.  
  76. IMPLEMENTATION
  77.  
  78. USES      Dos;
  79. VAR       OldInt1C:PROCEDURE;
  80.           SaveVs,Visible:BOOLEAN;
  81.  
  82. FUNCTION  CurKey:CHAR; ASSEMBLER;
  83.  ASM
  84.         MOV     AX,$0040
  85.         MOV     ES,AX
  86.         MOV     AX,$0000
  87.         MOV     BX,ES:[$001A]
  88.         CMP     BX,ES:[$001C]
  89.         JE      @Slt
  90.         MOV     AX,ES:[BX]
  91.         MOV     ScanCode,AH
  92. @Slt:
  93.  END;
  94.  
  95. FUNCTION  GetKey:CHAR; ASSEMBLER;
  96.  ASM
  97.         MOV     AX,$0040
  98.         MOV     ES,AX
  99.         MOV     AX,$0000
  100.         MOV     BX,ES:[$001A]
  101.         CMP     BX,ES:[$001C]
  102.         JE      @Vdr
  103.         MOV     AX,ES:[BX]
  104.         MOV     ScanCode,AH
  105. @Vdr:   CMP     BX,ES:[$0082]
  106.         JE      @Spc
  107.         INC     BX
  108.         INC     BX
  109.         JMP     @Slt
  110. @Spc:   MOV     BX,ES:[$0080]
  111. @Slt:   MOV     ES:[$001A],BX
  112.  END;
  113.  
  114. PROCEDURE DefLed(Led,Mtd:BYTE); ASSEMBLER;
  115.  ASM
  116.         MOV     AX,$0040
  117.         MOV     ES,AX
  118.         MOV     AH,Led
  119.         CMP     Mtd,0
  120.         JE      @Tgl
  121.         CMP     Mtd,1
  122.         JE      @On
  123.         NOT     AH
  124.         AND     ES:[$0017],AH
  125.         JMP     @Slt
  126. @On:    OR      ES:[$0017],AH
  127.         JMP     @Slt
  128. @Tgl:   XOR     ES:[$0017],AH
  129.         JMP     @Slt
  130. @Slt:   MOV     AH,1
  131.         INT     $16
  132.  END;
  133.  
  134. PROCEDURE Klick(F,L:WORD); ASSEMBLER;
  135.  ASM
  136.     CMP    Sound,ON
  137.     JNE    @End
  138.     IN      AL,$61
  139.     OR      AL,3
  140.     OUT     $61,AL
  141.     MOV     AL,182
  142.     OUT     $43,AL
  143.     MOV     AX,F
  144.     NOT     AX
  145.     SHR     AX,2
  146.     OUT     $42,AL
  147.     MOV     AL,AH
  148.     OUT     $42,AL
  149.     MOV     AX,L
  150. @oop1:  MOV     BX,1020
  151. @oop2:  DEC     BX
  152.     CMP     BX,0
  153.     JNE     @oop2
  154.     DEC     AX
  155.     CMP     AX,0
  156.     JNE     @oop1
  157.     IN      AL,$61
  158.     AND     AL,252
  159.     OUT     $61,AL
  160. @End:
  161.  END;
  162.  
  163. PROCEDURE BackToText; ASSEMBLER;
  164.  ASM
  165.           MOV     AX,$0003
  166.           INT     $10
  167.  END;
  168.  
  169.  
  170. FUNCTION  KeyPressed:BOOLEAN; ASSEMBLER;
  171.  ASM
  172.           MOV     AX,$0040
  173.           MOV     ES,AX
  174.           MOV     AL,$00
  175.           MOV     BX,ES:[$001A]
  176.           CMP     BX,ES:[$001C]
  177.           JE      @Slt
  178.           MOV     AL,$FF
  179. @Slt:
  180.  END;
  181.  
  182. FUNCTION  Event:BOOLEAN; ASSEMBLER;
  183.  ASM
  184.           MOV     AX,$3
  185.           INT     $33
  186.           MOV     AX,$0040            { Keybuffer empty?    }
  187.           MOV     ES,AX
  188.           MOV     AL,TRUE             { Return TRUE exiting }
  189.           MOV     BX,ES:[$001A]
  190.           MOV     TheEvent,KeyBoard
  191.           CMP     BX,ES:[$001C]
  192.           JNE     @Slt
  193.           MOV     TheEvent,Buttons
  194.           CMP     Mb,0                { Buttons pressed?    }
  195.           JNE     @Slt
  196.           PUSH    CX                  { Get Mouse Data      }
  197.           PUSH    DX
  198.           MOV     AX,$3
  199.           INT     $33
  200.           POP     BX
  201.           POP     AX
  202.           MOV     TheEvent,Horizontal
  203.           CMP     CX,AX               { Has Mx changed?     }
  204.           JNE     @Slt
  205.           MOV     TheEvent,Vertical
  206.           CMP     DX,BX               { Has My changed?     }
  207.           JNE     @Slt
  208.           MOV     AL,FALSE            { No, return FALSE    }
  209.           MOV     TheEvent,NoEvent
  210. @Slt:
  211.  END;
  212.  
  213. {---------------------------------------------------------------------------}
  214.  
  215. PROCEDURE EgaMode(Md:BYTE); ASSEMBLER;
  216.  ASM
  217.           MOV     AL,Md
  218.           CMP     AL,Mode
  219.           JE      @Slutt
  220.       CMP     Md,Vga640x480
  221.           JE      @480
  222.           CMP     Md,Ega640x350
  223.           JE      @350
  224.           CMP     Md,Ega640x200
  225.           JE      @200
  226.           CMP     Md,Ega320x200
  227.           JE      @320
  228.           JMP     @Slutt
  229. @480:     MOV     Colors,15
  230.           MOV     xMax,639
  231.           MOV     yMax,479
  232.           MOV     Video,$A000
  233.           MOV     Mode,AL
  234.           MOV     AX,$0012
  235.           INT     $10
  236.           JMP     @Slutt
  237. @350:     MOV     Colors,15
  238.           MOV     xMax,639
  239.           MOV     yMax,349
  240.           MOV     Video,$A000
  241.           MOV     Mode,AL
  242.           MOV     AX,$0010
  243.           INT     $10
  244.           JMP     @Slutt
  245. @200:     MOV     Colors,15
  246.           MOV     xMax,639
  247.           MOV     yMax,199
  248.           MOV     Video,$A000
  249.           MOV     Mode,AL
  250.           MOV     AX,$000E
  251.           INT     $10
  252.           JMP     @Slutt
  253. @320:     MOV     Colors,15
  254.           MOV     xMax,319
  255.           MOV     yMax,199
  256.           MOV     Video,$A000
  257.           MOV     Mode,AL
  258.           MOV     AX,$000D
  259.           INT     $10
  260.           JMP     @Slutt
  261. @Slutt:
  262.  END;
  263.  
  264.  
  265. FUNCTION  GetPix(X,Y:WORD):BYTE; ASSEMBLER;
  266.  ASM;
  267.           MOV     AX,Y
  268.           MOV     DX,80
  269.           CMP     Mode,Ega320x200
  270.           JNE     @Next
  271.           MOV     DX,40
  272. @Next:    MUL     DX
  273.           MOV     SI,X
  274.           MOV     CX,SI
  275.           SHR     SI,3
  276.           ADD     SI,AX
  277.           AND     CL,7
  278.           XOR     CL,7
  279.           MOV     CH,1
  280.           SHL     CH,CL
  281.           MOV     AX,Video
  282.           MOV     ES,AX
  283.           MOV     DX,$3Ce
  284.           MOV     AX,(3 SHL 8)+4
  285.           XOR     BL,BL
  286. @gp1:     OUT     DX,AX
  287.           MOV     BH,ES:[SI]
  288.           AND     BH,CH
  289.           NEG     BH
  290.           ROL     BX,1
  291.           DEC     AH
  292.           JGE     @gp1
  293.           MOV     AL,BL
  294.  END;
  295.  
  296. PROCEDURE SetPix(X,Y:WORD; Color:BYTE); ASSEMBLER;
  297.  ASM
  298.           MOV     CH,Color
  299.           MOV     AX,Y
  300.           MOV     DX,80
  301.           CMP     Mode,Ega320x200
  302.           JNE     @Next
  303.           MOV     DX,40
  304. @Next:    MUL     DX
  305.           MOV     BX,X
  306.           MOV     CL,BL
  307.           SHR     BX,3
  308.           ADD     BX,AX
  309.           AND     CL,7
  310.           MOV     AH,128
  311.           SHR     AH,CL
  312.           MOV     DX,$3CE
  313.           MOV     AL,8
  314.           OUT     DX,AX
  315.           MOV     AX,$0205
  316.           OUT     DX,AX
  317.           MOV     AX,Video
  318.           MOV     ES,AX
  319.           MOV     AL,ES:[BX]
  320.           MOV     ES:[BX],CH
  321.  END;
  322.  
  323. PROCEDURE Line(X1,Y1,X2,Y2:INTEGER; Col:BYTE);
  324.  VAR D,Dx,Dy,Ai,Bi,Xi,Yi,X,Y:INTEGER;
  325.  BEGIN                          
  326.    IF (ABS(X2-X1)<ABS(Y2-Y1)) THEN
  327.     BEGIN
  328.      IF Y1>Y2 THEN
  329.       ASM
  330.           MOV     AX,Y1
  331.           MOV     BX,Y2
  332.           MOV     Y1,BX
  333.           MOV     Y2,AX
  334.           MOV     AX,X1
  335.           MOV     BX,X2
  336.           MOV     X1,BX
  337.           MOV     X2,AX
  338.       END;
  339.       IF (X2>X1) THEN Xi:=1 ELSE Xi:=-1;
  340.       Dy:=Y2-Y1; Dx:=ABS(X2-X1); D:=Dx*2-Dy; Ai:=2*(Dx-Dy);
  341.       Bi:=Dx*2; X:=X1; Y:=Y1;
  342.       IF (X>=0) AND (Y>=0) AND (X<=xMax) AND (Y<=yMax) THEN SetPix(X,Y,Col);
  343.       FOR Y:=Y1+1 TO Y2 DO
  344.        BEGIN
  345.          IF (D>=0) THEN
  346.           ASM
  347.             MOV AX,X
  348.             ADD AX,Xi
  349.             MOV X,AX
  350.             MOV AX,D
  351.             ADD AX,Ai
  352.             MOV D,AX
  353.           END ELSE ASM
  354.             MOV AX,D
  355.             ADD AX,Bi
  356.             MOV D,AX
  357.           END;
  358.          IF (X>=0) AND (Y>=0) AND (X<=xMax) AND (Y<=yMax) THEN SetPix(X,Y,Col);
  359.        END;
  360.     END ELSE BEGIN             
  361.       IF (X1>X2) THEN
  362.        ASM
  363.          MOV AX,X1
  364.          MOV BX,X2
  365.          MOV X1,BX
  366.          MOV X2,AX
  367.          MOV AX,Y1
  368.          MOV BX,Y2
  369.          MOV Y1,BX
  370.          MOV Y2,AX
  371.        END;
  372.       IF (Y2>Y1) THEN Yi:=1 ELSE Yi:=-1;
  373.       Dx:=X2-X1; Dy:=ABS(Y2-Y1); D:=Dy*2-Dx; Ai:=2*(Dy-Dx);
  374.       Bi:=Dy*2; X:=X1; Y:=Y1;
  375.       IF (X>=0) AND (Y>=0) AND (X<=xMax) AND (Y<=yMax) THEN SetPix(X,Y,Col);
  376.       FOR X:=X1+1 TO X2 DO
  377.        BEGIN
  378.          IF (D>=0) THEN
  379.           ASM
  380.             MOV AX,Y
  381.             ADD AX,Yi
  382.             MOV Y,AX
  383.             MOV AX,D
  384.             ADD AX,Ai
  385.             MOV D,AX
  386.           END ELSE ASM
  387.             MOV AX,D
  388.             ADD AX,Bi
  389.             MOV D,AX
  390.           END;
  391.          IF (X>=0) AND (Y>=0) AND (X<=xMax) AND (Y<=yMax) THEN SetPix(X,Y,Col);
  392.        END;                     
  393.     END;                        
  394.  END;                           
  395.  
  396. PROCEDURE Hline(Xa,Xb,Y:WORD; Color:BYTE); ASSEMBLER;
  397. ASM
  398.           MOV     AX,Video
  399.           MOV     ES,AX
  400.           MOV     SI,Xa
  401.           MOV     AX,Xb
  402.           MOV     BX,Y
  403.           MOV     CH,Color
  404. @Loop:    PUSHA
  405.           MOV     AX,BX
  406.           MOV     DX,80
  407.           CMP     Mode,Ega320x200
  408.           JNE     @Next
  409.           MOV     DX,40
  410. @Next:    MUL     DX
  411.           MOV     BX,SI
  412.           MOV     CL,BL
  413.           SHR     BX,3
  414.           ADD     BX,AX
  415.           AND     CL,7
  416.           MOV     AH,128
  417.           SHR     AH,CL
  418.           MOV     DX,$3CE
  419.           MOV     AL,8
  420.           OUT     DX,AX
  421.           MOV     AX,$0205
  422.           OUT     DX,AX
  423.           MOV     AL,ES:[BX]
  424.           MOV     ES:[BX],CH
  425.           POPA
  426.           INC     SI
  427.           CMP     SI,AX
  428.           JLE     @Loop
  429. END;
  430.  
  431. PROCEDURE Vline(Ya,Yb,X:WORD; Color:BYTE); ASSEMBLER;
  432. ASM
  433.           MOV     AX,Video
  434.           MOV     ES,AX
  435.           MOV     SI,X
  436.           MOV     BX,Ya
  437.           MOV     DX,Yb
  438.           MOV     CH,Color
  439. @Loop:    PUSHA
  440.           MOV     AX,BX
  441.           MOV     DX,80
  442.           CMP     Mode,Ega320x200
  443.           JNE     @Next
  444.           MOV     DX,40
  445. @Next:    MUL     DX
  446.           MOV     BX,SI
  447.           MOV     CL,BL
  448.           SHR     BX,3
  449.           ADD     BX,AX
  450.           AND     CL,7
  451.           MOV     AH,128
  452.           SHR     AH,CL
  453.           MOV     DX,$3CE
  454.           MOV     AL,8
  455.           OUT     DX,AX
  456.           MOV     AX,$0205
  457.           OUT     DX,AX
  458.           MOV     AL,ES:[BX]
  459.           MOV     ES:[BX],CH
  460.           POPA
  461.           INC     BX
  462.           CMP     BX,DX
  463.           JLE     @Loop
  464. END;
  465.  
  466. PROCEDURE FBox(Xa,Ya,Xb,Yb:WORD; Color:BYTE); ASSEMBLER;
  467.  ASM
  468.           MOV     AX,Video
  469.           MOV     ES,AX
  470.           MOV     SI,Xa
  471.           MOV     AX,Xb
  472.           MOV     BX,Ya
  473.           MOV     DX,Yb
  474.           MOV     CH,Color
  475. @Loop:    PUSHA
  476.           MOV     AX,BX
  477.           MOV     DX,80
  478.           CMP     Mode,Ega320x200
  479.           JNE     @Next
  480.           MOV     DX,40
  481. @Next:    MUL     DX
  482.           MOV     BX,SI
  483.           MOV     CL,BL
  484.           SHR     BX,3
  485.           ADD     BX,AX
  486.           AND     CL,7
  487.           MOV     AH,128
  488.           SHR     AH,CL
  489.           MOV     DX,$3CE
  490.           MOV     AL,8
  491.           OUT     DX,AX
  492.           MOV     AX,$0205
  493.           OUT     DX,AX
  494.           MOV     AL,ES:[BX]
  495.           MOV     ES:[BX],CH
  496.           POPA
  497.           INC     SI
  498.           CMP     SI,AX
  499.           JLE     @Loop
  500.           MOV     SI,Xa
  501.           INC     BX
  502.           CMP     BX,DX
  503.           JLE     @Loop
  504.  END;
  505.  
  506. PROCEDURE Clear(Color:BYTE);
  507.  BEGIN
  508.    FBox(0,0,xMax,yMax,Color);
  509.  END;
  510.  
  511. PROCEDURE Box(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  512.  BEGIN
  513.    Hline(Xa,Xb,Ya,Color); Hline(Xa,Xb,Yb,Color);
  514.    Vline(Ya,Yb,Xa,Color); Vline(Ya,Yb,Xb,Color);
  515.  END;
  516.  
  517. {---------------------------------------------------------------------------}
  518.  
  519. PROCEDURE MouseInterrupt; INTERRUPT; ASSEMBLER;
  520.  ASM
  521.           MOV     AX,$3
  522.           INT     $33
  523.           CMP     Mode,Ega320x200
  524.           JNE     @Next
  525.           SHR     CX,1
  526. @Next:    MOV     Mb,BX
  527.           MOV     Mx,CX
  528.           MOV     My,DX
  529.           PUSHF
  530.  END;
  531.  
  532. PROCEDURE InitMouseIntr;
  533.  BEGIN
  534.    GetIntVec($1C,@OldInt1C);
  535.    SetIntVec($1C,Addr(MouseInterrupt));
  536.  END;
  537.  
  538. PROCEDURE EndMouseIntr;
  539.  BEGIN
  540.    SetIntVec($1C,@OldInt1C);
  541.  END;
  542.  
  543. FUNCTION  MouseReset:BOOLEAN; ASSEMBLER;
  544.  ASM
  545.           MOV     AX,$0000
  546.           INT     $33
  547.           CMP     AX,$0000
  548.           JE      @False
  549.           MOV     AL,TRUE
  550.           JMP     @TheEnd
  551. @False:   MOV     AL,FALSE
  552. @TheEnd:
  553.  END;
  554.  
  555. PROCEDURE Mouse(Vs:BOOLEAN); ASSEMBLER;
  556.  ASM
  557.           MOV     BL,Vs
  558.           CMP     BL,Visible
  559.           JE      @TheEnd
  560.           MOV     Visible,BL
  561.           MOV     AX,$0001
  562.           CMP     Vs,ON
  563.           JE      @SetCrs
  564.           MOV     AX,$0002
  565. @SetCrs:  INT     $33
  566. @TheEnd:
  567.  END;
  568.  
  569. PROCEDURE SaveMouse; ASSEMBLER;
  570.  ASM
  571.           CMP     SaveVs,ON
  572.           JE      @TheEnd
  573.           MOV     BL,Visible
  574.           MOV     SaveVs,BL
  575.           MOV     Visible,OFF
  576.           MOV     AX,$0002
  577.           INT     $33
  578. @TheEnd:
  579.  END;
  580.  
  581. PROCEDURE RestoreMouse; ASSEMBLER;
  582.  ASM
  583.           MOV     AX,$0001
  584.           CMP     SaveVs,ON
  585.           JE      @SetCrs
  586.           MOV     AX,$0002
  587. @SetCrs:  INT     $33
  588.           MOV     AL,SaveVs
  589.           MOV     Visible,AL
  590.           MOV     SaveVs,OFF
  591.  END;
  592.  
  593. PROCEDURE SetMousePos(X,Y:WORD); ASSEMBLER;
  594.  ASM
  595.           MOV     AX,$0004
  596.           MOV     CX,X
  597.           MOV     DX,Y
  598.           INT     $33
  599.  END;
  600.  
  601. PROCEDURE SetMousePtr; ASSEMBLER;
  602.  ASM
  603.           MOV     AX,SEG MousePtr
  604.           MOV     ES,AX
  605.           MOV     SI,OFFSET MousePtr
  606.           MOV     BX,ES:[SI]
  607.           MOV     CX,ES:[SI+2]
  608.           ADD     SI,4
  609.           MOV     DX,SI
  610.           MOV     AX,$0009
  611.           INT     $33
  612.  END;
  613.  
  614. PROCEDURE Waiting; ASSEMBLER;
  615.  ASM
  616.           MOV     AX,SEG MousePtr
  617.           MOV     ES,AX
  618.           MOV     DI,OFFSET MousePtr
  619.           MOV     AX,0000000000000000b; STOSW
  620.           MOV     AX,0000000000000000b; STOSW
  621.  
  622.           MOV     AX,1111100000111111b; STOSW
  623.           MOV     AX,1110000000001111b; STOSW
  624.           MOV     AX,1100000000000111b; STOSW
  625.           MOV     AX,1000000000000011b; STOSW
  626.           MOV     AX,1000000000000011b; STOSW
  627.           MOV     AX,0000000000000001b; STOSW
  628.           MOV     AX,0000000000000001b; STOSW
  629.           MOV     AX,0000000000000001b; STOSW
  630.           MOV     AX,0000000000000001b; STOSW
  631.           MOV     AX,0000000000000001b; STOSW
  632.           MOV     AX,1000000000000011b; STOSW
  633.           MOV     AX,1000000000000011b; STOSW
  634.           MOV     AX,1100000000000111b; STOSW
  635.           MOV     AX,1110000000001111b; STOSW
  636.           MOV     AX,1111100000111111b; STOSW
  637.           MOV     AX,1111111111111111b; STOSW
  638.  
  639.           MOV     AX,0000000000000000b; STOSW
  640.           MOV     AX,0000011011000000b; STOSW
  641.           MOV     AX,0001011111010000b; STOSW
  642.           MOV     AX,0011111011111000b; STOSW
  643.           MOV     AX,0011111011111000b; STOSW
  644.           MOV     AX,0101111011110100b; STOSW
  645.           MOV     AX,0111111011111100b; STOSW
  646.           MOV     AX,0011110000011000b; STOSW
  647.           MOV     AX,0111111011111100b; STOSW
  648.           MOV     AX,0101111111110100b; STOSW
  649.           MOV     AX,0011111111111000b; STOSW
  650.           MOV     AX,0011111111111000b; STOSW
  651.           MOV     AX,0001011111010000b; STOSW
  652.           MOV     AX,0000011011000000b; STOSW
  653.           MOV     AX,0000000000000000b; STOSW
  654.           MOV     AX,0000000000000000b; STOSW
  655.  END;
  656.  
  657. PROCEDURE Arrow; ASSEMBLER;
  658.  ASM
  659.           MOV     AX,SEG MousePtr
  660.           MOV     ES,AX
  661.           MOV     DI,OFFSET MousePtr
  662.           MOV     AX,0000000000000000b; STOSW
  663.           MOV     AX,0000000000000000b; STOSW
  664.  
  665.           MOV     AX,0011111111111111b; STOSW { oo           }
  666.           MOV     AX,0101111111111111b; STOSW { o o          }
  667.           MOV     AX,0110111111111111b; STOSW { o  o         }
  668.           MOV     AX,0111011111111111b; STOSW { o   o        }
  669.           MOV     AX,0111101111111111b; STOSW { o    o       }
  670.           MOV     AX,0111110111111111b; STOSW { o     o      }
  671.           MOV     AX,0111111011111111b; STOSW { o      o     }
  672.           MOV     AX,0111111101111111b; STOSW { o       o    }
  673.           MOV     AX,0111111110111111b; STOSW { o        o   }
  674.           MOV     AX,0111110000011111b; STOSW { o     ooooo  }
  675.           MOV     AX,0110110111111111b; STOSW { o  o  o      }
  676.           MOV     AX,0101011011111111b; STOSW { o o o  o     }
  677.           MOV     AX,0011011011111111b; STOSW { oo  o  o     }
  678.           MOV     AX,1111101101111111b; STOSW {      o  o    }
  679.           MOV     AX,1111101101111111b; STOSW {      o  o    }
  680.           MOV     AX,1111110001111111b; STOSW {       ooo    }
  681.  
  682.           MOV     AX,0000000000000000b; STOSW
  683.           MOV     AX,0100000000000000b; STOSW
  684.           MOV     AX,0110000000000000b; STOSW
  685.           MOV     AX,0111000000000000b; STOSW
  686.           MOV     AX,0111100000000000b; STOSW
  687.           MOV     AX,0111110000000000b; STOSW
  688.           MOV     AX,0111111000000000b; STOSW
  689.           MOV     AX,0111111100000000b; STOSW
  690.           MOV     AX,0111111110000000b; STOSW
  691.           MOV     AX,0111110000000000b; STOSW
  692.           MOV     AX,0110110000000000b; STOSW
  693.           MOV     AX,0100011000000000b; STOSW
  694.           MOV     AX,0000011000000000b; STOSW
  695.           MOV     AX,0000001100000000b; STOSW
  696.           MOV     AX,0000001100000000b; STOSW
  697.           MOV     AX,0000000000000000b; STOSW
  698.  END;
  699.  
  700. {---------------------------------------------------------------------------}
  701.  
  702. VAR Fs,Fo:WORD; 
  703.  
  704. PROCEDURE UseFont(Ptr:POINTER);
  705.  BEGIN
  706.    Fs:=SEG(Ptr^); Fo:=OFS(Ptr^)+1; Fh:=MEM[Fs:Fo-1];
  707.  END;
  708.  
  709. PROCEDURE PlotChar(X,Y:INTEGER; Ch:BYTE; Color,Bg:BYTE);
  710.  VAR T,U:BYTE;
  711.  BEGIN
  712.    IF (X<0) OR (Y<0) OR (X>xMax-8) OR (Y>yMax-Fh) THEN Exit;
  713.    FOR T:=0 TO 7 DO FOR U:=0 TO Fh-1 DO
  714.    IF MEM[Fs:Fo+Ch*Fh+U] AND  (128 SHR (T AND 7))=(128 SHR (T AND 7))
  715.       THEN SetPix(X+T,Y+U,Color) ELSE SetPix(X+T,Y+U,Bg);
  716.  END;
  717.  
  718. PROCEDURE DrawChar(X,Y:INTEGER; Ch:BYTE; Color:BYTE);
  719.  VAR T,U:BYTE;
  720.  BEGIN
  721.    IF (X<0) OR (Y<0) OR (X>xMax-8) OR (Y>yMax-Fh) THEN Exit;
  722.    FOR T:=0 TO 7 DO FOR U:=0 TO Fh-1 DO
  723.    IF MEM[Fs:Fo+Ch*Fh+U] AND  (128 SHR (T AND 7))=(128 SHR (T AND 7))
  724.       THEN SetPix(X+T,Y+U,Color);
  725.  END;
  726.  
  727. PROCEDURE WriteLine(X,Y:INTEGER; S:STRING; C,B:BYTE);
  728.  VAR T:BYTE;
  729.  BEGIN                                          
  730.    FOR T:=1 TO LENGTH(S) DO
  731.     IF C=B THEN DrawChar(X+(T-1)*8,Y,ORD(S[T]),C  )
  732.            ELSE PlotChar(X+(T-1)*8,Y,ORD(S[T]),C,B);
  733.  END;
  734.  
  735. {---------------------------------------------------------------------------}
  736.  
  737. PROCEDURE Button.Draw;
  738.  VAR A,B:BYTE;
  739.  BEGIN
  740.    SaveMouse;
  741.    IF Paa THEN BEGIN A:=Fg; Fg:=Sd; B:=Hl; Hl:=Sd; Sd:=B; END;
  742.    Box(Xa,Ya,Xb,Yb,0);
  743.    HLine(Xa+1,Xb-2,Ya+1,Hl); VLine(Ya+1,Yb-1,Xa+1,Hl);
  744.    HLine(Xa+2,Xb-1,Yb-1,Sd); VLine(Ya+1,Yb-1,Xb-1,Sd);
  745.    HLine(Xa+2,Xb-3,Ya+2,Hl); VLine(Ya+2,Yb-2,Xa+2,Hl);
  746.    HLine(Xa+3,Xb-2,Yb-2,Sd); VLine(Ya+2,Yb-2,Xb-2,Sd);
  747.    IF Oldtt<>Title THEN
  748.     BEGIN FBox(Xa+3,Ya+3,Xb-3,Yb-3,Bg); Oldtt:=Title; END;
  749.    WriteLine(Xa+1+(Xb-Xa-LENGTH(Title)*8) DIV 2
  750.             ,Ya+1+((Yb-Ya) DIV 2)-Fh DIV 2,Title,Fg,Fg);
  751.    IF Paa THEN BEGIN Fg:=A; Sd:=Hl; Hl:=B; END; RestoreMouse;
  752.  END;
  753.  
  754. PROCEDURE Button.Remove;
  755.  BEGIN SaveMouse; FBox(Xa,Ya,Xb,Yb,Bg); RestoreMouse; END;
  756.  
  757. PROCEDURE Button.Init(Ax,Ay,Bx,By:WORD; F,B,H,S:BYTE; T:STRING);
  758.  BEGIN
  759.    Xa:=Ax; Ya:=Ay; Xb:=Bx; Yb:=By; Paa:=OFF; Oldtt:='';
  760.    Fg:=F;  Bg:=B;  Hl:=H;  Sd:=S; Title:=T;
  761.  END;
  762.  
  763. FUNCTION  Button.Pressed:BOOLEAN;
  764.  BEGIN
  765.    Pressed:=FALSE;
  766.    IF Mb=0 THEN Exit;
  767.    IF (Mx>=Xa) AND (My>=Ya) AND (Mx<=Xb) AND (My<=Yb) THEN
  768.     BEGIN
  769.       Klick(100,10); Paa:=NOT Paa; Draw;
  770.       REPEAT UNTIL Mb=0; Pressed:=TRUE;
  771.       Klick(100,10); Paa:=NOT Paa; Draw;
  772.     END;
  773.  END;
  774.  
  775. FUNCTION  Button.Switched:BOOLEAN;
  776.  BEGIN
  777.    Switched:=FALSE;
  778.    IF Mb=0 THEN Exit;
  779.    IF (Mx>=Xa) AND (My>=Ya) AND (Mx<=Xb) AND (My<=Yb) THEN
  780.     BEGIN
  781.       Klick(100,10); Paa:=NOT Paa; Draw;
  782.       REPEAT UNTIL Mb=0; Switched:=TRUE;
  783.     END;
  784.  END;
  785.  
  786. {---------------------------------------------------------------------------}
  787.  
  788. PROCEDURE Window.Draw;
  789.  BEGIN
  790.    SaveMouse;
  791.    EgaDraw.FBox (Xa+1   ,Ya+1   ,Xb-1   ,Yb-1,Bg);
  792.    EgaDraw.HLine(Xa     ,Xb     ,Ya     ,Hl);
  793.    EgaDraw.HLine(Xa     ,Xb     ,Yb     ,Sd);
  794.    EgaDraw.VLine(Ya     ,Yb     ,Xa     ,Hl);
  795.    EgaDraw.VLine(Ya     ,Yb     ,Xb     ,Sd);
  796.    EgaDraw.HLine(Xa+4   ,Xb-4   ,Ya+5+Fh,Sd);
  797.    EgaDraw.HLine(Xa+4   ,Xb-4   ,Yb-3   ,Hl);
  798.    EgaDraw.VLine(Ya+5+Fh,Yb-3   ,Xa+4   ,Sd);
  799.    EgaDraw.VLine(Ya+5+Fh,Yb-3   ,Xb-4   ,Hl);
  800.    EgaDraw.WriteLine(Xa+(Xb-Xa-8*LENGTH(Title)) DIV 2,Ya+3,Title,Fg,Bg);
  801.    EgaDraw.FBox (Xa+5   ,Ya+6+Fh,Xb-5   ,Yb-4,Sc);
  802.    RestoreMouse;
  803.  END;
  804.  
  805. PROCEDURE Window.Remove;
  806.  BEGIN
  807.    SaveMouse;
  808.    EgaDraw.FBox(Xa,Ya,Xb,Yb,Bg);
  809.    RestoreMouse;
  810.  END;
  811.  
  812. PROCEDURE Window.Init(A,B,C,D:WORD; E,F,G,H:BYTE; I:STRING; J:BYTE);
  813.  BEGIN
  814.    Xa:=A; Ya:=B; Xb:=C; Yb:=D; Fg:=E; Bg:=F; Hl:=G; Sd:=H; Title:=I; Sc:=J;
  815.    Xl:=Xb-Xa-10; Yl:=Yb-Ya-10-Fh;
  816.  END;
  817.  
  818. PROCEDURE Window.WriteLine(A,B:WORD; C:STRING);
  819.  BEGIN
  820.    SaveMouse;
  821.    EgaDraw.WriteLine(Xa+5+A,Ya+6+Fh+B,C,Fg,Sc);
  822.    RestoreMouse;
  823.  END;
  824.  
  825. PROCEDURE Window.SetPix(X,Y:WORD; C:BYTE);
  826.  BEGIN
  827.    EgaDraw.SetPix(Xa+5+X,Ya+6+Fh+Y,C);
  828.  END;
  829.  
  830. FUNCTION  Window.GetPix(X,Y:WORD):BYTE;
  831.  BEGIN
  832.    GetPix:=EgaDraw.GetPix(Xa+5+X,Ya+6+Fh+Y);
  833.  END;
  834.  
  835. PROCEDURE Window.Line(A,B,C,D,E:INTEGER);
  836.  BEGIN
  837.    SaveMouse;
  838.    EgaDraw.Line(Xa+5+A,Ya+6+Fh+B,Xa+5+C,Ya+6+Fh+D,E);
  839.    RestoreMouse;
  840.  END;
  841.  
  842. FUNCTION  Window.Test:BOOLEAN;
  843.  VAR A,B:WORD;
  844.  BEGIN
  845.    IF (Mx>=Xa) AND (Mx<=Xb) AND (My>=Ya) AND (My<=Ya+5+Fh) AND (Mb=1) THEN
  846.     BEGIN
  847.       Remove;
  848.       A:=Mx-Xa; B:=My-Ya; Xb:=Xb-Xa; Yb:=Yb-Ya;
  849.       SaveMouse;
  850.       REPEAT
  851.     Xa:=Mx-A; Ya:=My-B;
  852.         IF Xa<0 THEN Xa:=0; IF Ya<0 THEN Ya:=0;
  853.         IF Xa+Xb>xMax THEN Xa:=xMax-Xb;
  854.         IF Ya+Yb>yMax THEN Ya:=yMax-Yb;
  855.     EgaDraw.Box(Xa,Ya,Xa+Xb,Ya+Yb,Sd);
  856.     EgaDraw.Box(Xa,Ya,Xa+Xb,Ya+Yb,Bg);
  857.       UNTIL Mb=0;
  858.      RestoreMouse;
  859.      Xb:=Xa+Xb; Yb:=Ya+Yb;
  860.      Draw;
  861.     END;
  862.  END;
  863.  
  864. BEGIN
  865.   Mode:=Unknown; Visible:=OFF; SaveVs:=OFF; Sound:=ON;
  866. END.